home *** CD-ROM | disk | FTP | other *** search
/ Aminet 25 / Aminet 25 (1998)(GTI - Schatztruhe)[!][Jun 1998].iso / Aminet / misc / emu / unBINSCII.lha / unBINSCII.p < prev    next >
Encoding:
Text File  |  1998-03-03  |  3.2 KB  |  135 lines
  1. program unBINSCII;
  2.  
  3. var firstTime, match: Boolean;
  4.     size, last, limit, i, j, k: integer;
  5.     fileSize, chunkSize, lines: long;
  6.     fileName: string[32];
  7.     xlate: string[64];
  8.     line: string[132];
  9.     values: array[0..63] of byte;
  10.     out: array[0..47] of byte;
  11.     a: text;
  12.     b: file of byte;
  13.  
  14. procedure Convert4x6to3x8(iX, oX: integer);
  15.   var i, j: integer;
  16.       temp: long;
  17.       bytes: array[0..3] of byte;
  18.   begin
  19.     for i := 0 to 3
  20.       do begin
  21.         j := 0;
  22.         repeat
  23.           j := j + 1;
  24.           match := line[iX + i + 1] = xlate[j]
  25.         until match or (j = 64);
  26.         if match
  27.             then bytes[i] := j - 1
  28.           else bytes[i] := 255
  29.       end;
  30.     temp := (long(bytes[3]) and $3F) shl 18
  31.              + (bytes[2] and $3F) shl 12
  32.              + (bytes[1] and $3F) shl 6
  33.              + bytes[0] and $3F;
  34.     out[oX] := temp shr 16;
  35.     out[oX + 1] := (temp shr 8) and $FF;
  36.     out[oX + 2] := temp and $FF
  37.   end;
  38.  
  39. function reverse3: long;
  40.   begin
  41.     reverse3 := out[2] * 65536 + out[1] * 256 + out[0]
  42.   end;
  43.  
  44. begin
  45.   firstTime := true;
  46.   if ParamCount <> 1
  47.       then begin
  48.         writeln('Usage: unBINSCII pathname');
  49.         halt(20)
  50.       end
  51.     else fileName := ParamStr(1);
  52.   assign(a, fileName);
  53.   reset(a);
  54.   repeat
  55.     repeat
  56.       readln(a, line)
  57.     until (line = 'FiLeStArTfIlEsTaRt') or eof(a);
  58.     if eof(a)
  59.         then begin
  60.           writeln('Unexpected EOF!');
  61.           close(a);
  62.           close(b);
  63.           halt(20)
  64.         end;
  65.     readln(a, line);
  66.     if length(line) <> 64
  67.         then begin
  68.           writeln('Translate table error!');
  69.           close(a);
  70.           close(b);
  71.           halt(20)
  72.         end
  73.       else xlate := line;
  74.     readln(a, line);
  75.     if length(line) <> 52
  76.         then begin
  77.           writeln('File attributes error');
  78.           close(a);
  79.           close(b);
  80.           halt(20)
  81.         end;
  82.     if firstTime
  83.         then begin
  84.           size := ord(line[1]) - 64;
  85.           fileName := copy(line, 2, size);
  86.           writeln('The output file will be named ''', fileName, '''');
  87.           assign(b, fileName);
  88.           rewrite(b);
  89.           Convert4x6to3x8(16, 0);
  90.           fileSize := reverse3;
  91.           writeln('File size = ',fileSize)
  92.           firstTime := false
  93.         end;
  94.     Convert4x6to3x8(44, 0);
  95.     chunkSize := reverse3;
  96.     writeln('  Chunk size = ', chunkSize);
  97.     lines := chunkSize div 48;
  98.     last := chunkSize mod 48;
  99.     if last <> 0
  100.         then lines := lines + 1;
  101.     limit := 47;
  102.     for i := 1 to lines
  103.       do begin
  104.         readln(a, line);
  105.         if length(line) <> 64
  106.             then begin
  107.               writeln('Data line error!');
  108.               close(a);
  109.               close(b);
  110.               halt(20)
  111.             end;
  112.         k := 0;
  113.         for j := 0 to 15
  114.           do begin
  115.             Convert4x6to3x8(j * 4, k);
  116.             k := k + 3
  117.           end;
  118.         if (i = lines) and (last <> 0)
  119.             then limit := last - 1;
  120.         for j := 0 to limit
  121.           do write(b, out[j])
  122.       end;
  123.     readln(a, line)
  124.     if length(line) <> 4
  125.         then begin
  126.           writeln('Wrong size chunk trailer!');
  127.           close(a);
  128.           close(b);
  129.           halt(20)
  130.         end
  131.   until eof(a);
  132.   close(b);
  133.   close(a)
  134. end.
  135.